home *** CD-ROM | disk | FTP | other *** search
/ Sprite 1984 - 1993 / Sprite 1984 - 1993.iso / lib / tcl / mxedit.menus < prev    next >
Encoding:
Text File  |  1992-07-16  |  9.7 KB  |  321 lines
  1. #
  2. # mxedit.menus
  3. #    Definitions for the menus used in the mxedit application.
  4. #    This defines the following procedures that operate on menus
  5. #    by their label name instead of by their TK widget name.
  6. #    This makes it easier for users to understand customization.
  7. #    mxMenu - define a menu by name
  8. #    mxMenuAdd - add an entry to a menu
  9. #    mxMenuBind - define a keyboard accelerator for a menu item.
  10. #    mxMenuEntryConfigure - change a menu entry
  11. #
  12. # Copyright (c) 1992 Xerox Corporation.
  13. # Use and copying of this software and preparation of derivative works based
  14. # upon this software are permitted. Any distribution of this software or
  15. # derivative works must comply with all applicable United States export
  16. # control laws. This software is made available AS IS, and Xerox Corporation
  17. # makes no warranty about the software, its performance or its conformity to
  18. # any specification.
  19.  
  20. # Imported globals
  21. # file - the name of the current file
  22.  
  23. # Exported globals
  24. # For each menu defined by mxMenu under label "Foo", there is a
  25. # global variable called menuFoo defined that holds the identity of
  26. # the menu widget.  This is relied on by mxMenuAdd and mxMenuBind
  27.  
  28. # File globals
  29. # menubar - the frame that holds menubuttons
  30.  
  31. # mxMenuSetup --
  32. # Called from mxsetup to create the menubar frame
  33.  
  34. proc mxMenuSetup { parent } {
  35.     global menubar
  36.     set menubar [buttonFrame $parent .buttons 2]
  37.     return $menubar
  38. }
  39.  
  40. # mxCreateMenus --
  41. #    This is invoked from mxsetup in order to fill out the menubar
  42.  
  43. proc mxCreateMenus { } {
  44.     foreach menuProc { mxFileMenu mxEditMenu mxSearchMenu mxWindowMenu
  45.                mxHelpMenu mxGeometryMenu} {
  46.     if [catch $menuProc msg] {
  47.         puts stderr "$menuProc failed: $msg"
  48.     }
  49.     }
  50. }
  51.  
  52. # mxMenu --
  53. #    Add a new menu and associated menubutton to the mxedit menubar.
  54. #    The name of the menu widget is remembered for later use
  55. #    with mxMenuBind and mxMenuBind
  56.  
  57. proc mxMenu { label {where {left}} } {
  58.     global menubar
  59.     set name .${label}
  60.     set menu [basicMenu $menubar${name}Menu]
  61.     packedMenuButton $menubar ${name}Buttton $label $menu $where
  62.  
  63.     # Remember the widget name under a variable derived from the label.
  64.     # This allows mxMenuBind to be passed the label instead of the widget.
  65.     global menu${label}
  66.     set menu${label} $menu
  67.  
  68.     return $menu
  69. }
  70. # mxMenuBind --
  71. # Bind a keystroke sequence to a menu entry.
  72. # Use this procedure in order to keep the menus up-to-date
  73. # with keyboard accelerators.
  74. # This hardwires the binding to the mxedit widget.
  75.  
  76. proc mxMenuBind { sequence menuName label } {
  77.     global mxedit
  78.     global menu${menuName}
  79.     set menu [set menu${menuName}]
  80.  
  81.     if [catch {
  82.     set command [lindex [$menu entryconfigure $label -command] 4]
  83.     bind $mxedit $sequence $command
  84.     $menu entryconfigure [$menu index $label] -accelerator $sequence
  85.     } msg] {
  86.     mxFeedback "mxMenuBind $sequence $menuName $label: $msg"
  87.     }
  88. }
  89.  
  90. # mxMenuUnBind --
  91. # Remove a binding from an menu entry
  92. # Use this procedure in order to keep the menus up-to-date
  93. # with keyboard accelerators.
  94.  
  95. proc mxMenuUnBind { menuName label } {
  96.     global mxedit
  97.     global menu${menuName}
  98.     set menu [set menu${menuName}]
  99.  
  100.     if [catch {
  101.     set sequence [lindex [$menu entryconfigure $label -accelerator] 4]
  102.     bind $mxedit $sequence {}
  103.     $menu entryconfigure [$menu index $label] -accelerator {}
  104.     } msg] {
  105.     mxFeedback "mxMenuUnBind $menuName $label: $msg"
  106.     }
  107. }
  108.  
  109. # mxMenuAdd --
  110. #    Add an item to a menu.
  111.  
  112. proc mxMenuAdd { menuName label command } {
  113.     global menu${menuName}
  114.     set menu [set menu${menuName}]
  115.     if [catch {$menu add command -label $label -command $command} msg] {
  116.     mxFeedback "menu add $menu \"$label\" failed: $msg"
  117.     }
  118. }
  119.  
  120. # mxMenuAddSeparator --
  121. #    Add a separator to a menu.
  122.  
  123. proc mxMenuAddSeparator { menuName label } {
  124.     global menu${menuName}
  125.     set menu [set menu${menuName}]
  126.     if [catch {$menu add separator -label $label} msg] {
  127.     mxFeedback "menu add separator $menu \"$label\" failed: $msg"
  128.     }
  129. }
  130.  
  131. # mxMenuEntryConfigure --
  132. #    Change an item in a menu.
  133.  
  134. proc mxMenuEntryConfigure { menuName label args } {
  135.     global menu${menuName}
  136.     set menu [set menu${menuName}]
  137.     if [catch [concat $menu entryconfigure \"$label\" $args] msg] {
  138.     mxFeedback "menu entryconfigure $menu \"$label\" failed: $msg"
  139.     }
  140. }
  141.  
  142. # mxFileMenu --
  143. #    Define the FILE menu
  144.  
  145. proc mxFileMenu { } {
  146.     global file
  147.  
  148.     mxMenu File
  149.     mxMenuAdd File "Save and quit"     {save ; quit}
  150.     mxMenuAdd File "Save"         {save}
  151.     mxMenuAdd File "Save in file SEL"     {saveSel}
  152.     mxMenuAdd File "Open new window"     {mxopen $file}
  153.     mxMenuAdd File "Open file SEL"     {applyToSelection mxopen} 
  154.     mxMenuAdd File "Switch to file SEL" {applyToSelection switch} 
  155.     mxMenuAdd File "Switch to previous file"     {switchBack}
  156.     mxMenuAdd File "Switch to tag SEL"     {applyToSelection tag} 
  157.     mxMenuAdd File "Open on tag SEL"     {applyToSelection tagOpen}
  158.     mxMenuAdd File "Go to line SEL"     {history next history \
  159.                         {applyToSelection line}}
  160.     mxMenuAdd File "Reset"         {reset}
  161.     mxMenuAdd File "Quit"         {quit}
  162. }
  163.  
  164. # mxEditMenu --
  165. #    Define the Edit menu
  166.  
  167. proc mxEditMenu { } {
  168.     mxMenu Edit
  169.     mxMenuAdd Edit "Undo"         {undo}
  170.     mxMenuAdd Edit "Do Again"         {history ignore redo}
  171.     mxMenuAdd Edit "Delete SEL"        {deleteSel}
  172.     mxMenuAdd Edit "Paste"        {paste}
  173.     mxMenuAdd Edit "Move SEL"        {moveSel}
  174.     mxMenuAdd Edit "Indent line"     {indentLine}
  175.     mxMenuAdd Edit "Indent SEL"        {indentSel}
  176.     mxMenuAdd Edit "Outdent line"     {outdentLine}
  177.     mxMenuAdd Edit "Outdent SEL"     {outdentSel}
  178. }
  179.  
  180. # mxSearchMenu --
  181. proc mxSearchMenu { } {
  182.     mxMenu Search
  183.     mxMenuAdd Search "Forward"         {findInner forward}
  184.     mxMenuAdd Search "Forward for SEL"     {findInner forwSel}
  185.     mxMenuAdd Search "Backward"     {findInner backward} 
  186.     mxMenuAdd Search "Backward for SEL"    {findInner backSel}
  187.     mxMenuAdd Search "Replace"         {findInner replace} 
  188.     mxMenuAdd Search "Replace in SEL"     {findInner replaceSel}
  189.     mxMenuAdd Search "Replace Everywhere" {findInner replaceEverywhere}
  190. }
  191.  
  192. # mxWindowMenu --
  193. proc mxWindowMenu { } {
  194.     mxMenu Window
  195.  
  196.     mxCommandMenuEntry Window
  197.  
  198.     mxMenuAdd Window "Search"         {find}
  199. }
  200.  
  201. # mxHelpMenu --
  202. proc mxHelpMenu { } {
  203.     mxMenu Help
  204.     mxMenuAdd Help "Show key bindings"         {showBindings}
  205.     mxMenuAdd Help "Show variables"         {showVars}
  206.     mxMenuAdd Help "Show procedures"         {showProcs}
  207.     mxMenuAdd Help "Emacs bindings"         {emacsBindings}
  208. }
  209.  
  210. # mxGeometryMenu --
  211. proc mxGeometryMenu { } {
  212.     mxMenu Right {right}
  213.     mxMenu Left {right}
  214.  
  215.     mxMenuAdd Right "Upper Right"    {upperRight}
  216.     mxMenuAdd Right "Lower Right"    {lowerRight}
  217.     mxMenuAdd Right "Full Right"    {fullRight}
  218.  
  219.     mxMenuAdd Left "Upper Left"        {upperLeft}
  220.     mxMenuAdd Left "Lower Left"        {lowerLeft}
  221.     mxMenuAdd Left "Full Left"        {fullLeft}
  222. }
  223. # upperRight --
  224. proc upperRight { } {
  225.     setupTilingGeometry charsWide linesHigh right left top bottom
  226.     geometry ${charsWide}x${linesHigh}+${right}+${top}
  227. }
  228. # upperRight --
  229. proc lowerRight { } {
  230.     setupTilingGeometry charsWide linesHigh right left top bottom
  231.     geometry ${charsWide}x${linesHigh}+${right}+${bottom}
  232. }
  233. # upperLeft --
  234. proc upperLeft { } {
  235.     setupTilingGeometry charsWide linesHigh right left top bottom
  236.     geometry ${charsWide}x${linesHigh}+${left}+${top}
  237. }
  238. # lowerLeft --
  239. proc lowerLeft { } {
  240.     setupTilingGeometry charsWide linesHigh right left top bottom
  241.     geometry ${charsWide}x${linesHigh}+${left}+${bottom}
  242. }
  243. # fullRight --
  244. proc fullRight { } {
  245.     global rightMenu
  246.     setupFullGeometry Right \
  247.         charsWide linesHigh right left top
  248.     geometry ${charsWide}x${linesHigh}+${right}+${top}
  249. }
  250. # fullLeft --
  251. proc fullLeft { } {
  252.     global leftMenu
  253.     setupFullGeometry Left charsWide linesHigh right left top
  254.     geometry ${charsWide}x${linesHigh}+${left}+${top}
  255. }
  256.  
  257. # setupTilingGeometry
  258. #    This uses the size of the screen and the size of the window to
  259. #    figure out how to place the window in different tiled locations
  260.  
  261. proc setupTilingGeometry { charsWide linesHigh right left top bottom } {
  262.     upvar 1 $charsWide wide $linesHigh high $left L $right R $top T $bottom B
  263.  
  264.     scan [wm geometry .] "%dx%d" wide high
  265.     scan [winfo geometry .] "%dx%d+%d+%d" mainWidth mainHeight xoff yoff
  266.  
  267.     set L 0
  268.     set T 0
  269.     if {[screenwidth] > (2 * $mainWidth)} {
  270.     set R [expr {10 + $mainWidth}]
  271.     } else {
  272.     set R [expr {[screenwidth] - $mainWidth}]
  273.     }
  274.  
  275.     if {[screenheight] > (2 * ($mainHeight+20))} {
  276.     set B [expr {40 + $mainHeight}]
  277.     } else {
  278.     set B [expr {[screenheight] - $mainHeight}]
  279.     }
  280. }
  281.  
  282. # setupFullGeometry
  283. #    This uses the size of the screen and the size of the window to
  284. #    figure out how to make a full sized window
  285.  
  286. proc setupFullGeometry { menuName charsWide linesHigh right left top } {
  287.     upvar 1 $charsWide wide $linesHigh high $left L $right R $top T
  288.  
  289.     # Happily, the wm grid command reports the original size of the window,
  290.     # even if it has been resized.  winfo, happily, returns the current size
  291.     # so that the following computation alternately computes a full sized
  292.     # and original sized window
  293.     scan [wm grid .] "%d %d %d %d" wide high xinc yinc
  294.     scan [winfo geometry .] "%dx%d+%d+%d" mainWidth mainHeight xoff yoff
  295.     set extraHeight [expr {$mainHeight - ($yinc * $high)}]
  296.     set availHeight [expr {[screenheight] - $extraHeight}]
  297.     set oldHigh $high
  298.     set high [expr {($availHeight / $yinc) - 1}]
  299.  
  300.     set L 0
  301.     set T 0
  302.     if {[screenwidth] > (2 * $mainWidth)} {
  303.     set R [expr {10 + $mainWidth}]
  304.     } else {
  305.     set R [expr {[screenwidth] - $mainWidth}]
  306.     }
  307.     # Fix up the menu so it reflects what will happen next
  308.     # Remember that menuName is "Right" or "Left", and that
  309.     # the value of menuLeft is the menu under the Left label...
  310.  
  311.     global menu${menuName}
  312.     set menu [set menu${menuName}]
  313.  
  314.     if {$high > $oldHigh} {
  315.     $menu entryconfigure "Full $menuName" -label "Small $menuName"
  316.     } else {
  317.     $menu entryconfigure "Small $menuName" -label "Full $menuName"
  318.     }
  319. }
  320.  
  321.